home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / OBJINFO.INC < prev    next >
Text File  |  1994-04-30  |  8KB  |  341 lines

  1.  
  2.  
  3. {SECTION INFO_object }
  4. CONSTRUCTOR INFO_object.init(max : integer);
  5. var l : longint;
  6.     i : integer;
  7.      begin
  8.      sepchar := ';';   { separator between key and data }
  9.      sortmode := true; { ascending }
  10.      sorted  := false; { not sorted yet }
  11.      infoheader.init;
  12.      keystring.init(max);
  13.      keyvalue.init(max);
  14.      end;
  15.  
  16.  
  17. procedure INFO_object.setsepchar(sep : char);
  18.      begin
  19.      sepchar := sep;   { separator between key and data }
  20.      end;
  21.  
  22.  
  23. {
  24. procedure INFO_object.dispose;
  25. var l : longint;
  26.     i : integer;
  27.     ok : boolean;
  28.      begin
  29.      keyvalue.done;
  30.      keystring.done;
  31.      infoheader.dispose;
  32.      sorted := false;
  33.      end; }
  34.  
  35.  
  36. procedure INFO_object.done;   {conformity 2/94}
  37. var l : longint;
  38.     i : integer;
  39.     ok : boolean;
  40.      begin
  41.      keyvalue.done;
  42.      keystring.done;
  43.      infoheader.dispose;
  44.      sorted := false;
  45.      end;
  46.  
  47.  
  48. procedure INFO_object.clear;
  49. var l : longint;
  50.     i : integer;
  51.     ok : boolean;
  52.      begin
  53.      keystring.clear;
  54.      keyvalue.clear;
  55.      sorted := false;
  56.      end;
  57.  
  58.  
  59.  
  60. Function  INFO_object.Count : integer;
  61.      begin
  62.      Count := keystring.count;
  63.      end;
  64.  
  65.  
  66. Function  INFO_object.ArrayMaxSize : integer;
  67.      begin
  68.      ArrayMaxSize := keystring.ArrayMaxSize;
  69.      end;
  70.  
  71.  
  72. Function  INFO_object.storeheader (s : string) : boolean;
  73.      begin
  74.      storeheader := infoheader.store(s);
  75.      end;
  76.  
  77.  
  78. Function  INFO_object.fetchheader : string;
  79.      begin
  80.      fetchheader := infoheader.fetch;
  81.      end;
  82.  
  83.  
  84. Function INFO_object.store(ks,kv : string) : boolean;
  85. var OK : boolean;
  86.     n  : integer;
  87.      begin
  88.      n := keystring.find(ks);
  89.      if n > 0 then
  90.           begin
  91.           OK := keystring.storeN(n,UpCaseStr(ks));
  92.           if OK then OK := keyvalue.storeN(n,kv);
  93.           end
  94.      else begin
  95.           OK := keystring.append(UpCaseStr(ks));
  96.           if OK then OK := keyvalue.append(kv);
  97.           end;
  98.      store := OK;
  99.      sorted := false;
  100.      end;
  101.  
  102.  
  103. Function INFO_object.fetch(ks : string) : string;
  104. var n : integer;
  105.     s : string;
  106.      begin
  107.      s := '';
  108.      n := keystring.find(ks);
  109.      if n > 0 then s := keyvalue.fetchN(n);
  110.      fetch := s;
  111.      end;
  112.  
  113.  
  114. Function  INFO_object.FetchString(ks : string) : string;
  115.     begin
  116.     FetchString := INFO_object.fetch(ks);
  117.     end;
  118.  
  119.  
  120. Function  INFO_object.FetchInteger(ks : string) : integer;
  121.     begin
  122.     FetchInteger := StrInt(INFO_object.fetch(ks));
  123.     end;
  124.  
  125.  
  126. Function  INFO_object.FetchLongInt(ks : string) : longint;
  127.     begin
  128.     FetchLongInt := StrLong(INFO_object.fetch(ks));
  129.     end;
  130.  
  131.  
  132. Function  INFO_object.Fetchreal(ks : string) : real;
  133.     begin
  134.     Fetchreal := StrReal(INFO_object.fetch(ks));
  135.     end;
  136.  
  137.  
  138. Function  INFO_object.FetchBoolean(ks : string) : boolean;
  139. var result : boolean;
  140.     s      : string;
  141.     begin
  142.     result := false;
  143.     s := UpCaseStr(INFO_object.fetch(ks));
  144.     if s = 'YES' then result := true;
  145.     FetchBoolean := result;
  146.     end;
  147.  
  148.  
  149. Function INFO_object.fetchkeyn(n : integer) : string;
  150. var s : string;
  151.      begin
  152.      s := '';
  153.      if n > 0 then s := keystring.fetchN(n);
  154.      fetchkeyn := s;
  155.      end;
  156.  
  157.  
  158. Function INFO_object.fetchn(n : integer) : string;
  159. var s : string;
  160.      begin
  161.      s := '';
  162.      if n > 0 then s := keyvalue.fetchN(n);
  163.      fetchn := s;
  164.      end;
  165.  
  166.  
  167. Function  INFO_object.search (ks : string; mode : byte) : string;
  168. { returns key string matching request }
  169. var n : integer;
  170.     s : string;
  171.      begin
  172.      s := '';
  173.      n := keystring.search(ks,mode);
  174.      if n > 0 then s := keystring.fetchN(n);
  175.      search := s;
  176.      end;
  177.  
  178.  
  179.  
  180. Procedure INFO_object.dump;
  181. var i  : integer;
  182.      begin
  183.      writeln('Info object dump  ', keystring.count);
  184.      if keystring.count < 1 then exit;
  185.      for i := 1 to keystring.count do
  186.           begin
  187.           writeln(i:4,' [',keystring.fetchN(i),']  [',
  188.                            keyvalue.fetchN(i),']');
  189.           end;
  190.      writeln('');
  191.      end;
  192.  
  193.  
  194. Procedure INFO_object.save(fname : string);
  195. var i  : integer;
  196.     OK : boolean;
  197.     TEXTF : TFILE_object;
  198.      begin
  199.      if keystring.count < 1 then exit;
  200.      TEXTF.init(fname,true);
  201.      TEXTF.append('*'+infoheader.fetch);
  202.      for i := 1 to keystring.count do
  203.          begin
  204.          TEXTF.append(keystring.fetchN(i)+sepchar+keyvalue.fetchN(i));
  205.          end;
  206.      TEXTF.done;
  207.      end;
  208.  
  209.  
  210. Procedure INFO_object.load(fname : string);
  211. var s,s1 : string;
  212.     i : integer;
  213.     OK : boolean;
  214.     TEXTF : TFILE_object;
  215.      begin
  216.      TEXTF.init(fname,false);
  217.      while ok and TEXTF.fetchnext(s) do
  218.          begin
  219.          if (INFO_object.count = 0) and (s[1] = '*') then
  220.               begin
  221.               delete(s,1,1);
  222.               ok := infoheader.store(s);
  223.               end
  224.          else begin
  225.               s1 := '';
  226.               i := pos(sepchar,s);
  227.               if i > 1 then
  228.                    begin
  229.                    s1 := s;
  230.                    delete(s1,1,i);
  231.                    s := leftstr(s,i-1);
  232.                    end;
  233.               ok := INFO_object.store(s,s1);
  234.               end;
  235.          end;
  236.      TEXTF.done;
  237.      end;
  238.  
  239. {$R-}
  240.  
  241. Procedure INFO_object.swap(i,j : integer);
  242. var OK : boolean;
  243. var s  : string;
  244.     nd : integer;
  245.      begin
  246.      s  := keystring.fetchN(i);
  247.      OK := keystring.storeN(i,keystring.fetchN(j));
  248.      OK := keystring.storeN(j,s);
  249.      s  := keyvalue.fetchN(i);
  250.      OK := keyvalue.storeN(i,keyvalue.fetchN(j));
  251.      OK := keyvalue.storeN(j,s);
  252.      end;
  253.  
  254.  
  255. Function needswapping(sortflag : boolean; s1,s2 : string) : boolean;
  256. var result : boolean;
  257.      begin
  258.      result := false;
  259.      if          sortflag and (s1 < s2) then result := true
  260.      else if not sortflag and (s1 > s2) then result := true;
  261.      needswapping := result;
  262.      end;
  263.  
  264.  
  265. procedure INFO_object.setsortmode(flag : boolean);
  266.      begin
  267.      sortmode := flag; { true := ascending, false = descending }
  268.      end;
  269.  
  270.  
  271. procedure INFO_object.sort;
  272. var Gap,I,J,N : integer;
  273.     s1,s2      : string;
  274.      begin
  275.      N   := INFO_object.count;
  276.      Gap := N div 2;
  277.      while (Gap > 0) do
  278.          begin
  279.          I := Gap;
  280.          while (I < N) do
  281.               begin
  282.               J := I - Gap;
  283.               s1 := UpCaseStr(keystring.fetchN(J+Gap+1));
  284.               s2 := UpCaseStr(keystring.fetchN(J+1));
  285.               while (J >= 0) and needswapping(sortmode,s1,s2) do
  286.                    begin
  287.                    INFO_object.swap(J+1,J+Gap+1);
  288.                    dec(J,Gap);
  289.                    s1 := UpCaseStr(keystring.fetchN(J+Gap+1));
  290.                    s2 := UpCaseStr(keystring.fetchN(J+1));
  291.                    end;
  292.               inc(I);
  293.               end;
  294.          Gap:=Gap div 2;
  295.          end;
  296.      sorted := true;
  297.      end;
  298.  
  299. {$R+}
  300. {SECTION .LOOKUP_object }
  301. Procedure LOOKUP_object.init(num : integer);
  302.      begin
  303.      hold.init(num);
  304.      end;
  305.  
  306.  
  307. Procedure LOOKUP_object.append(tag,str : string);
  308. var s : string;
  309.      begin
  310.      s := tag;   trim(s);   s := UpCaseStr(s);
  311.      hold.store(s,str);
  312.      end;
  313.  
  314.  
  315. Function  LOOKUP_object.lookup (tag : string) : string;
  316. var s : string;
  317.     i : integer;
  318.      begin
  319.      s := tag;   trim(s);   s := UpCaseStr(s);
  320.      lookup := hold.fetchstring(s);
  321.      end;
  322.  
  323.  
  324. Function  LOOKUP_object.fetchN(n : integer) : string;
  325.      begin
  326.      fetchN := hold.fetchN(n);
  327.      end;
  328.  
  329.  
  330. Procedure LOOKUP_object.dump;
  331.      begin
  332.      hold.dump;
  333.      end;
  334.  
  335.  
  336. Procedure LOOKUP_object.done;
  337.      begin
  338.      hold.done;
  339.      end;
  340.  
  341.